;;; idrop.el --- Drop-down menu interface
;;
;; Filename: idrop.el
;; Description: Drop-down menu interface
;; Author: Jaeyoun Chung [jay.chung@gmail.com]
;; Maintainer:
;; Copyright (C) 2008 Jaeyoun Chung
;; Created: Sun Mar 16 11:20:45 2008 (Pacific Daylight Time)
;; Version: 
;; Last-Updated: Sun Mar 16 12:19:49 2008 (Pacific Daylight Time)
;;           By: dradams
;;     Update #: 43
;; URL: FIXME
;; Keywords: convenience menu
;; Compatibility: GNU Emacs 21.x, GNU Emacs 22.x
;;
;; Features that might be required by this library:
;;
;;   `cl'.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;;  TODO: Write a description of the package
;;
;;  According to Jaeyoun Chung, "overlay code stolen from company-mode.el."
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;; 2008/xx/xx capitaomorte
;;     Renamed to idrop.el from dropdown-list.el. All symbols renamed.
;;     Expanded and redid much functionlity.
;;     Kept compatibility of `dropdown-list' function.
;;     Provided more example usages.
;; 2008/03/16 dadams
;;     Clean-up - e.g. use char-to-string for control chars removed by email posting.
;;     Moved example usage code (define-key*, command-selector) inside the library.
;;     Require cl.el at byte-compile time.
;;     Added GPL statement.
;; 2008/01/06 Jaeyoun Chung
;;     Posted to gnu-emacs-sources@gnu.org at 9:10 p.m.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:

(eval-when-compile (require 'cl)) ;; decf, fourth, incf, loop, mapcar*, subseq

;;;
;;; User customizable faces
;;;
;;; TODO: comment these faces and warn about known issues.
;;; 
(defface idrop
  '((t :inherit default :background "light steel blue" :foreground "dodger blue"))
  "Face used in the idrop. This mostly defines the idrop
background, and is used by other faces who inherit from it."
  :group 'idrop)

(defface idrop-selection
  '((t :inherit idrop :background "dodger blue" :foreground "snow"))
  "Face used in the idrop, for the candidate that is currently
  selected."
  :group 'idrop)

(defface idrop-indicator
  '((t :inherit idrop
       :foreground "OrangeRed"))
  "Face used in the idrop, for the number indicators"
  :group 'idrop)

(defface idrop-indicator-mouse-highlight
  '((t :underline 'on
       :inherit idrop-indicator))
  "Face used in the idrop, for the number indicators, when the
mouse is hovering about."
  :group 'idrop)

(defface idrop-extra-indicator
  '((t :inherit idrop
       :foreground "tomato"))
  "Face used in the idrop for the candidate's extra indicators."
  :group 'idrop)

(defface idrop-text
  '((t :inherit idrop
       :weight bold
       :underline 'on))
  "Face used for the user-entered text in the idrop."
  :group 'idrop)

(defface idrop-submenu
  '((t :weight bold
       :underline 'on
       :inherit idrop))
  "Face used to indentify a candidate that is a submenu or has subcandidates."
  :group 'idrop)

(defface idrop-candidate
  '((t :background "light gray" :inherit idrop))
  "Face used to indentify a normal candidate."
  :group 'idrop)

(defface idrop-candidate-mouse-highlight
  '((t :underline 'on
       :inherit idrop-selected))
  "Face used to indentify a normal candidate."
  :group 'idrop)

(defface idrop-disabled
  '((t :underline 'on
       :foreground "Sky Blue"
       :inherit idrop-candidate))
  "Face used for candidates which are either unselectable or
unconfirmable"
  :group 'idrop-candidate)

(defface idrop-title
  '((t :underline 'on
       :inherit idrop-indicator))
  "Face used in the title of the idrop."
  :group 'idrop)

;;;
;;; User customizable variables
;;;

(defcustom idrop-can-scroll-indicator "<more>"
  "Indicator string used if scrolling is possible."
  :type '(string)
  :group 'idrop)

(defcustom idrop-back-indicator "<back>"
  "Indicator string used if going back to a previous idrop is
possible."
  :type '(string)
  :group 'idrop)

(defcustom idrop-no-match-indicator "<no match>"
  "Indicator string used no matches exist."
  :type '(string)
  :group 'idrop)

(defcustom idrop-ellipsis-indicator "..."
  "Substitute string if the text of the idrop is too long.

This string should preferably be quite short in width, as it
itself takes up space in the dropdown. Unspecified behaviour when
the width of `idrop-ellipsis-indicator' exceeds or nears
`idrop-nominal-line-width'."
  :type '(string)
  :group 'idrop) 

(defcustom idrop-can-scroll-around nil
  "If non-NIL scroll around is possible in the idrop list."
  :type '(boolean)
  :group 'idrop)

(defcustom idrop-nominal-width 10
  "Maximum width in colums of the \"shortened\" version of the
idrop, excluding the number indicators.

If any idrop candidate and its extra indicators exceeds this
width, it will be truncated, using `idrop-ellipsis-indicator'.

The maximum width of the idrop can then be switched to
`idrop-max-line-width' which should allow every candidate to be
displayed untruncatred."
  :type '(integer)
  :group 'idrop)

(defcustom idrop-nominal-dimensions (cons 25 7)
  "Maximum width and height in colums/lines of the \"shortened\"
version of the idrop.

The width excludes the digit indicators. TODO: fix this
inconsistent behaviour

If any idrop candidate and its extra indicators exceeds the
specified width width, it will be truncated, using
`idrop-ellipsis-indicator'.

If any idrop candidates are scrolled out, an
`idrop-can-scroll-indicator' is added as an unselectable
candidate.

The maximum dimensions of the idrop can then be switched to
`idrop-max-dimensions' which tries to display candidates
untruncated and minimize the number of scrolled out candidates."
  :type '(cons)
  :group 'idrop
  )

(defcustom idrop-max-dimensions (cons 60 25)
  "Maximum width and height in colums/lines of the \"lengthened\"
version of the idrop.

See the description of `idrop-nominal-dimensions'"
  :type '(cons)
  :group 'idrop)

(defcustom idrop-indicator-width 3
  "Width in columns for a idrop number indicator."
  :type '(integer)
  :group 'idrop)


(defcustom idrop-vary-width (list 'onfiltering)
  "Non-nil means the idrop can stretch or collapse in width to
  accomodate longer or smaller candidates.


Value is a list of symbols. The following symbols are possible as
elements of a list:

`onfiltering'  vary width when refiltering

`onscrolling'  vary width when rescrolling

Otherwise, the idrop keeps its width, except when explicitly
commanded to redimension"
  :type '(list)
  :group 'idrop)

(defcustom idrop-use-number-indicators t
  "Non-nil means display numbered indicator shortcuts besides
  each candidate."
  :type '(boolean)
  :group 'idrop)

(defcustom idrop-merge-subcandidates (list 'ontab 'filter)
  "Controls showing nested subcandidates in the idrop.

Value is a list of symbols. The following symbols are possible as
elements of a list:

`filter' Show subcandidates when filtering is applied.

`ontab'  Eventually show subcandidates if `idrop-magic-tab' is
	 invoked a sufficient number of times.n

`alwaus' Always show subcandidates.

Subcandidates are only expanded up to
`idrop-merge-subcandidates-max-depth' levels"
  ;; TODO: get the widget type in here
  :type '(list)
  :group 'idrop)

(defcustom idrop-merge-subcandidates-max-depth 3
  "Maximum depth to considered when merging subcandidates."
  :type '(integer)
  :group 'idrop)


(defcustom idrop-merge-keep-parent-candidate 'never 
  "Decide if the parent menu should be shown when merging
  subcandidates.

The following value are possible:

`never' Hide the parent even if some of its subcandidates appear.

`always' Show the parent even if none of its subcandidates
	 appear.

`maybe'    Show the parent only if some of its subcandidates
	   appear.

All other values mean keep the parent candidate if its name
matches the search."
  :type '(choice (const :tag "Depends, maybe"  maybe)
		 (const :tag "Always"	       always)
		 (const :tag "Never"	       never))
  :group 'idrop)

(defcustom idrop-scroll-context-lines 2
  "Number of candidates to keep after each `idrop-scroll-up' or
  `idrop-scroll-down' command"
  :type 'integer
  :group 'idrop)


;;;
;;; Internal types `idrop' and `idrop-candidate' and accessors.
;;;

(defstruct (idrop (:constructor idrop-make-idrop))
  "TODO: Describe this structure"
  buffer
  candidates
  filtered
  numbered
  (selidx nil)
  width
  nvisible
  (scrolled-out 0)
  overlays
  title
  previous
  (depth 0)
  hiding-candidates
  (truncating-candidates nil) 
  merging-subcandidates)



(defun idrop-enlarged-p (dd)
  "Return t if DD is \"enlarged\" to `idrop-max-dimensions'"
  (and (eq idrop-current-max-line-width (car idrop-max-dimensions))
       (eq idrop-current-max-height (cdr idrop-max-dimensions))))

(defun idrop-hiding-candidates-p (dd)
  (idrop-hiding-candidates dd))

(defun idrop-merging-subcandidates-p (dd)
  (idrop-merging-subcandidates dd))

(defun idrop-can-complete-user-input-p (dd)
  ;; TODO: add preficate for tab completion
  nil)

(defstruct (idrop-candidate (:constructor idrop-make-candidate))
  "Defines candidate object to be displayed in the idrop list.

TODO: review this

NAME is a string, symbol or an expression returning string. The
resulting string will still be propertized with property `face'
and value `idrop-candidate' or `idrop-selection' depending on
whether the candidate is selected or not.

CALLBACK is a function to be called without args or an expression
to be evaluated.

SELECTABLE is a boolean expression indicating if the item can be
selected.

CONFIRMABLE is a boolean expression indicating if the item can be
confirmed.

EXTRA-INDICATOR is a string or an expression, that should return
a small string. The string will still be propertized with
property `face' and value `idrop-indicator'

HELP is a string or expression that should return a string. The
string is displayed in the echo area when the candidate is
selected."
  name
  callback
  selectable
  confirmable
  hidden
  extra-indicator
  help
  subcandidates
  (depth 0))

(defun idrop-candidate-call-callback (candidate)
  "Executes whichever command is defined for CANDIDATE.

  In case CANDIDATE is a submenu and no `:callback' property is
  defined, this function automatically calls `idrop-internal' on
  the subcandidates"
  (let ((callback-prop (idrop-candidate-callback candidate)))
    (cond ((null callback-prop)
	   (if (idrop-candidate-submenu-p candidate)
	       (idrop-internal (idrop-candidate-spawn-subcandidates candidate)
			       (idrop-candidate-string candidate)
			       'subidrop)
	     (idrop-candidate-string candidate)))
	  ((consp callback-prop)
	   (eval callback-prop))
	  (t
	   (if (commandp callback-prop)
	       (call-interactively callback-prop)
	     (funcall callback-prop))))))
	   

(defun idrop-candidate-selectable-p (candidate)
  "Returns non-Nil if CANDIDATE is selectable in the idrop."
  (let ((selectable-prop (idrop-candidate-selectable candidate)))
    (or (null selectable-prop)
	(eval selectable-prop))))

(defun idrop-candidate-confirmable-p (candidate)
  "Returns non-Nil if CANDIDATE is confirmable in the idrop,
i.e. if the corresponding callback is enabled."
  (let ((selectable-prop (idrop-candidate-confirmable candidate)))
    (or (null selectable-prop)
	(eval selectable-prop))))

(defun idrop-candidate-hidden-p (candidate)
  "Returns non-Nil if CANDIDATE is hidden in the idrop,
i.e. if it is NOT displayed when `idrop-hiding-candidates-p' for
the idrop is non-Nil."
  (let ((hidden-prop (idrop-candidate-hidden candidate)))
    (or (not (null hidden-prop))
	(eval hidden-prop))))

(defun idrop-candidate-full-width (candidate)
  "Returns the full width in columns of CANDIDATE, adding the
  `string-width' of its formatted string, the possible
  subcandidate indent, and the length of any extra-indicators."
  (let* ((normal-width (string-width (idrop-candidate-string candidate)))
	 (extra-indicator (idrop-candidate-make-extra-indicator candidate))
	 (extra-width (when extra-indicator (string-width extra-indicator)))
	 (extra-extra-width (* (idrop-candidate-depth candidate) (string-width idrop-depth-indent-string))))
    (apply #'+ (remove nil (list normal-width extra-width extra-extra-width)))))

(defun idrop-candidate-string (candidate)
  "Returns the full name of CANDIDATE, from its `:name-prop'
expression"
  (let ((name-prop (idrop-candidate-name candidate)))
    (cond ((stringp name-prop)
	   name-prop)
	  ((symbolp name-prop)
	   (symbol-name name-prop))
	  (t
	   (eval name-prop)))))

(defun idrop-candidate-make-extra-indicator (candidate)
  "Returns the extra-indicators of CANDIDATE, from its
`:extra-indicator' property"
  (let ((extra-indicator-prop (idrop-candidate-extra-indicator candidate)))
    (when extra-indicator-prop
      (if (stringp extra-indicator-prop)
	  extra-indicator-prop
	(eval extra-indicator-prop)))))

(defun idrop-candidate-spawn-subcandidates (candidate)
  "Returns a fresh list of subcandidates for CANDIDATE, from its
`:subcandidates-prop' property.

TODO: consider additional function for performance reasons
`idrop-candidate-cached-subcandidates'"
  (let* ((subcandidates-prop (idrop-candidate-subcandidates
			      candidate))
	 (subcandidates (and subcandidates-prop
			     (eval subcandidates-prop))))
    (when subcandidates
      (mapc #'(lambda (sub)
		(setf (idrop-candidate-depth sub) (1+ (idrop-candidate-depth candidate))))
	    subcandidates))))

(defun idrop-calculate-candidate-depth (idrop candidate)
  "Return the depth of CANDIDATE relative to the IDROP.

This can differ from `idrop-candidate-depth' when IDROP is itself
a subidrop"
  (- (idrop-candidate-depth candidate)
     (idrop-depth idrop)))

(defun idrop-candidate-submenu-p (candidate)
  "Return t when CANDIDATE is a submenu."
  (when (idrop-candidate-subcandidates candidate) t))

(defun idrop-candidate-simple-format (idrop candidate)
  "Format CANDIDATE for IDROP.

The functions name contains the word \"simple\" because maybe in
future extensions more complex functions can be added"
  (let* ((submenu-p (idrop-candidate-subcandidates candidate))
	 (available-width (- (idrop-width dd) (idrop-candidate-depth candidate)))
	 (extra-indicator (idrop-candidate-make-extra-indicator candidate))
	 (not-indented-string (idrop-format-line (idrop-candidate-string candidate)
						 (- available-width idrop-indicator-width)
						 (cond (submenu-p
							'idrop-submenu)
						       ((not (and (idrop-candidate-confirmable-p candidate)
								  (idrop-candidate-selectable-p candidate)))
							'idrop-disabled)
						       (t
							'idrop-candidate))
						 extra-indicator
						 32
						 'idrop-extra-indicator)))
    (concat (propertize (apply #'concat (make-list (idrop-candidate-depth candidate) idrop-depth-indent-string))
			'face 'idrop-candidate)
	    (idrop-format-line
	     (propertize not-indented-string
			 'mouse-face 'idrop-candidate-mouse-highlight
			 'keymap (idrop-make-candidate-keymap idrop candidate))
	     available-width
	     (when (eq candidate (idrop-selected idrop)) 'idrop-selection)
	     (idrop-make-number-indicator idrop candidate submenu-p)
	     32))))

(defun idrop-make-candidate-keymap (idrop candidate)
  ;; PERF: cache these keymaps, or find some other way, the only thing
  ;; changing here is the position of the candidate in the
  ;; `idrop-filtered' list.
  (let ((map (make-sparse-keymap)))
    (define-key map [down-mouse-1] `(lambda (&optional event)
				      (interactive)
				      (setf (idrop-selidx (idrop-active)) ,(position candidate (idrop-filtered idrop)))
				      'idrop-confirm))
    (set-keymap-parent map idrop-control-keymap)
    map))


(defun idrop-make-number-indicator (dd candidate &optional submenu-p)
  "Makes an indicator for CANDIDATE, member of the candidates in
IDROP."
  (let ((position (and idrop-use-number-indicators
		       (position candidate (idrop-numbered dd))))
	(string (make-string idrop-indicator-width 32)))
    ;; place the number indicator in the last char or the indicator
    (if (and position
	     (< position 9))
	(aset string (1- idrop-indicator-width) (+ ?1 position)))
    (when submenu-p
      (aset string 0 ?>))
    string))

(defun idrop-make-can-scroll-indicator (&optional down)
  ;; PERF: caching this stuff might be useful 
  (propertize idrop-can-scroll-indicator
	      'mouse-face 'idrop-indicator-mouse-highlight
	      'local-map (let ((keymap (make-sparse-keymap)))
			   (define-key keymap [down-mouse-1] #'(lambda (&optional event)
								 (interactive)
								 (message "want to scroll %s" down)))
			   keymap)))

(defun idrop-make-back-indicator ()
  (propertize idrop-back-indicator
	      'mouse-face 'idrop-indicator-mouse-highlight
	      'local-map (let ((keymap (make-sparse-keymap)))
			   (define-key keymap [down-mouse-1] 'idrop-back)
			   keymap)))
				
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Keymap variables

(defvar idrop-control-keymap (make-sparse-keymap)
  "Keymap used while navigating the idrop list")

(defvar idrop-limited-edition-keymap (make-sparse-keymap)
  "Keymap used while inputing stuff into the idrop")

(defun idrop-setup-keymaps ()
  ;; TODO: take the hardcoded shit from here
  (setq idrop-limited-edition-keymap (make-sparse-keymap))

  ;; idrop-control-keymap
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "C-p") 'idrop-previous-candidate)
    (define-key map (kbd "C-r") 'idrop-previous-candidate)
    (define-key map (kbd "C-n") 'idrop-next-candidate)
    (define-key map (kbd "C-s") 'idrop-nex-candidate)

    (define-key map (kbd "C-v") 'idrop-scroll-up)
    (define-key map (kbd "M-v") 'idrop-scroll-down)

    (define-key map (kbd "C-l") 'idrop-enlarge) ;;TODO: should later be idrop-recenter

    (define-key map (kbd "M-p") 'idrop-previous-history-element)
    (define-key map (kbd "M-n") 'idrop-next-history-element)

    (define-key map (kbd "RET") 'idrop-confirm)
    (define-key map (kbd "<backspace>") 'idrop-magic-backspace)
    (define-key map (kbd "DEL") 'idrop-magic-backspace)
    (define-key map (kbd "C-g") 'idrop-quit)

    (define-key map (kbd "<space>") 'idrop-magic-tab)
    (define-key map "\t" 'idrop-magic-tab)

    (define-key map [down-mouse-1] 'idrop-execute-mouse-event)
    (define-key map [mouse-1]      'idrop-do-nothing)

    (define-key map `[,mouse-wheel-up-event]   'idrop-wheel-scroll-up)
    (define-key map `[,mouse-wheel-down-event] 'idrop-wheel-scroll-down)

    (do* ((char (make-vector 1 ?0) (prog1 char (aset char 0 (1+ (aref char 0))))))
	((> (aref char 0) ?9))
      (define-key map  char 'idrop-digit-shortcut))

;;     ;; lower and uppercase letters retain their function
;;     (do* ((char (make-vector 1 ?A) (prog1 char (aset char 0 (1+ (aref char 0))))))
;; 	((> (aref char 0) ?z))
;;       (define-key map  char 'self-insert-command))

    (setq idrop-control-keymap map)))

(eval-when-compile
  (idrop-setup-keymaps))

;; FIXME: remove when not needed
;;
;; (defconst idrop-control-overlay-priority 3)
;; (defconst idrop-default-overlay-priority 0)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Misc internal variables
;;;
;;; TODO: some of these have to be user variables

(defvar idrop-list nil
  "Holds the currently active idrop list")

(defvar idrop-control-overlay nil
  "Overlay used to associate `idrop-control-keymap' to.")

(defvar idrop-format-candidate-function #'idrop-candidate-simple-format
  "Function used to format candidates")

(defvar idrop-filter-function #'idrop-filter-substring
  "Function used to filter candidates")

(defvar idrop-text nil
  "Holds the input text of the user")

(defvar idrop-keep-previous-idrop nil
  ;; TODO: implement `idrop-keep-previous-idrop' 
  "Non-nil means the previous idrop should keep showing if
  possible, even when a sub-idrop is shown")

(defvar idrop-display-method 'idrop-display-overlays
  ;; TODO: implement `idrop-display-method'
  "Specifies what display method the idrop should use.

The value is a function receiving two arguments: an `idrop'
structure and a formatted idrop (see `idrop-display-format').

The following functions can be used

`idrop-display-overlays'    Use text overlays
`idrop-display-mini-frame'  Use a special popup frame
`idrop-display-tooltip'     Use a tooltip")


(defvar idrop-current-max-line-width (car idrop-nominal-dimensions)
  "Holds the current maximum width in columns of the idrop. The
  user can invoke `idrop-toggle-max-width' to toggle this between
  the values set in `idrop-nominal-width' and `idrop-max-width'.")

(defvar idrop-current-max-height (cdr idrop-nominal-dimensions)
  "Holds the current maximum height in screen-lines of the
  idrop. The user can invoke `idrop-toggle-max-height' to toggle
  this between the values set in `idrop-nominal-height' and
  `idrop-max-height'.")

(defvar idrop-depth-indent-string " "
  "String used when indenting subcandidates in the idrop.

This string is repeated `idrop-calculate-candidate-depth' times.")

(defvar idrop-recalculate nil
  "A list of symbols representing pending internal formatting actions to the idrop list.

The list is processed by the function `idrop-recalculate-maybe'. Each element can be:

`restretch'
`refilter'
`rescroll'")

(defvar idrop-display-center-p t
  "Indicates if the idrop should be displayed centered in the screen")

(defvar idrop-saved-window nil
  "The window the idrop was first invoked in")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Internal functions

(defun idrop-active ()
  "Returns the currently active idrop"
  idrop-list)

(defun idrop-cleanup (&optional dd)
  "Remove all traces idrop DD or the currently active idrop."
  (let* ((dd (or dd
		 (idrop-active)))
	 (control-overlay idrop-control-overlay))
    ;;
    ;; delete the normal overlays
    ;;
    (when dd (idrop-undisplay dd))
    ;;
    ;; delete control overlay
    ;;
    (when control-overlay (delete-overlay control-overlay))
    ;;
    ;; remove the idrop from `pre-command-hook'
    ;;
    (remove-hook 'pre-command-hook   'idrop-check-status)
    (remove-hook 'post-command-hook  'idrop-refresh)))

(defun idrop-cleanup-temp-buffer ()
  (let ((buf (get-buffer "*idrop-text*")))
    (setq idrop-text nil)
    (when buf (kill-buffer buf))))

(defun idrop-init (dd &optional subidropp)
  "Initialize important internal idrop variables for idrop DD.

When SUBIDROP is non-nil consider that DD is a subidrop. This is
called by `idrop-internal' which itself has the SUBIDROP
parameter"
  
  (cond ( ;; initilization of a subidrop
	 (and idrop-list
	      subidrop)
	 (setf (idrop-previous dd) idrop-list)
	 (setf (idrop-depth dd) (1+ (idrop-depth idrop-list)))
	 (setq idrop-recalculate (list 'refilter 'rescroll 'restretch)))
	( ;; root idrop
	 t
	 (idrop-cleanup-temp-buffer)
	 (setq idrop-text nil)
	 (setq idrop-current-max-line-width (car idrop-nominal-dimensions))
	 (setq idrop-current-max-height (cdr idrop-nominal-dimensions))
	 (setq idrop-recalculate (list 'refilter 'rescroll 'restretch))))
  ;; common to either root or subidrops
  (setq idrop-list dd))


(defun idrop-selected (dd &optional selidx) 
  "Return the currently selected idrop filtered candidate for DD,
if any. SELIDX, when non-nil specifies a an alternate selection
index instead of `idrop-selidx'"
  (let* ((selidx (or selidx
		     (idrop-selidx dd)))
	 (possible (and selidx
			(nth selidx (idrop-filtered dd)))))
    (when (and possible
	       (idrop-candidate-selectable-p possible))
      possible)))

(defun idrop-nfiltered (dd)
  "Return the number of filtered candidates for DD."
  (length (idrop-filtered dd)))

(defun idrop-text ()
  "Return the currently input user text to the idrop, or nil if
none or it is an empty string"
  (and (stringp idrop-text)
       (not (string= idrop-text ""))
       idrop-text))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Display function
;;;
;;; FIXME: PERF: There's a horrible memory leak somewhere, I think it
;;; has to do with currently not reusing the overlays.
;;;
(defun idrop-display-format (dd)
  "Formats the idrop DD for displaying. 

Returs a list (LINES OFFSET):

- LINES is a list of strings of the same width, properly
  propertized representing the title, user-input, candidates and
  possible indicators of DD.

- OFFSET is the index of LINES that should be displayed in
  current line current curson position, depending on the value of
  `idrop-display-align'"
  (let ((voffset 0)
	(cands (remove nil (subseq (idrop-filtered dd)
				   (idrop-scrolled-out dd)
				   (+ (idrop-scrolled-out dd) (idrop-nvisible dd))))))
    ;; take care of the numbering
    (setf (idrop-numbered dd) (remove-if-not #'idrop-candidate-confirmable-p cands))
    ;;
    ;;  PERF: might prove useful as an optimization, but don't think so...
    ;;
    ;;  (do (((e (idrop-numbered dd) (cdr e))
    ;; 	  (i 1			 (1+ i)))
    ;; 	 (or (= i 10)
    ;; 	     (null e)))
    ;; 	(setf (idrop-candidate-tempnumber (car e)) i))
    ;; 
    
    (list
     (remove nil
	     (append
	      (list
	       ;;
	       ;; user input text, if any
	       ;; 
	       (when (idrop-text)
		      (incf voffset)
		      (idrop-format-line idrop-text (idrop-width dd) 'idrop-text))
	       ;;
	       ;; title, if any
	       ;;
	       (when (idrop-title dd)
		 (incf voffset)
		 (idrop-format-line (idrop-title dd) (idrop-width dd) 'idrop-title (unless (eq 0 (idrop-depth dd))
										     (idrop-make-back-indicator))))
	       ;;
	       ;; scroll-up indicator
	       ;; 
	       (when (idrop-can-scroll 'up dd)
		 (incf voffset)
		      (idrop-format-line "" (idrop-width dd) 'idrop-indicator (idrop-make-can-scroll-indicator 'up))))
	      ;;
	      ;; the candidates themselves
	      ;; 
	      (or (mapcar #'(lambda (c)
			      (funcall idrop-format-candidate-function dd c))
			  cands)
		  (list (idrop-format-line "" (idrop-width dd) 'idrop-indicator idrop-no-match-indicator)))
	      
	      (list
	       ;;
	       ;; scroll-down indicator
	       ;;
	       (when (idrop-can-scroll 'down dd)
		      (idrop-format-line "" (idrop-width dd) 'idrop-indicator (idrop-make-can-scroll-indicator 'down))))))
     voffset)))

(defun idrop-display (dd)
  "Displays the idrop list."
  (setf (idrop-truncating-candidates dd) nil)
  (funcall idrop-display-method dd (idrop-display-format dd)))

(defun idrop-undisplay (dd)
  "Undisplays the idrop list DD."
  (funcall idrop-display-method dd nil))

(defun idrop-display-overlays (dd format)
  "Internal function for displaying the dropdown DD with overlays"
  ;; TODO: for `overlays' method, support auto-extending buffer when
  ;;       no space exists
  ;;
  ;; TODO: for `overlays' method, support non-truncated lines, or 
  ;;       should this be a limitation?
  ;;
  ;; TODO: add animation when nothing better to do, which really isn't now.
  ;;
  (if format
      (let* ((start-column	(idrop-start-column (+ (idrop-width dd)
						       idrop-indicator-width)))
	     (idrop-direction (idrop-calculate-direction dd))
	     (vincrement (if (eq 'down idrop-direction) 1 -1))
	     (lines (first format))
	     (voffset (second format)))
	(when (idrop-previous dd)
	  (idrop-overlays-delete (idrop-previous dd)))
	(idrop-overlays-delete dd)
	(save-excursion
	  (if idrop-display-center-p
	      (move-to-window-line (/ (- (window-height) (length lines)) 2))
	    (vertical-motion (* -1 vincrement voffset)))
	  (dolist (line lines)
	    (idrop-overlays-line start-column line)
	    ;;(when animatep (progn (sleep-for 0 10) (redisplay)))
	    (vertical-motion vincrement))))
    (idrop-overlays-delete dd)))
         
(defun idrop-display-tooltip (dd format)
  (x-show-tip (reduce #'(lambda (a b)
			  (concat a "\n" b))
		      (first lines))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Overlay related functions

(defun idrop-overlays-delete (dd)
  "Cleanup the overlays in the idrop list DD."
  (mapcar #'delete-overlay (idrop-overlays dd))) 

(defun idrop-overlays-put-overlay (beg end &optional prop value prop2 value2)
  "Copied from old `dropdown-put-overlay'. Actually displays the overlays, I think"
  
  (let ((ov (make-overlay beg end)))
    (overlay-put ov 'window t)
    (when prop
      (overlay-put ov prop value)
      (when prop2 (overlay-put ov prop2 value2)))
    ov))

(defun idrop-overlays-line (start replacement &optional no-insert)
  "Copied from old `dropdown-line', with minimal modifications."
  ;; start might be in the middle of a tab, which means we need to hide the
  ;; tab and add spaces
  (let ((end (+ start (string-width replacement)))
        beg-point end-point
        before-string after-string)
    (goto-char (point-at-eol))
    (if (< (current-column) start)
        (progn (setq before-string (make-string (- start (current-column)) ? ))
               (setq beg-point (point)))
      (goto-char (point-at-bol)) ; Emacs bug, move-to-column is wrong otherwise
      (move-to-column start)
      (setq beg-point (point))
      (when (> (current-column) start)
        (goto-char (1- (point)))
        (setq beg-point (point))
        (setq before-string (make-string (- start (current-column)) ? ))))
    (move-to-column end)
    (setq end-point (point))
    (let ((end-offset (- (current-column) end)))
      (when (> end-offset 0) (setq after-string (make-string end-offset ? ))))
    (when no-insert
      ;; prevent inheriting of faces
      (setq before-string (when before-string (propertize before-string 'face 'default)))
      (setq after-string (when after-string (propertize after-string 'face 'default))))
    (let ((string (concat before-string replacement after-string)))
      (if no-insert
          string
        (push (idrop-overlays-put-overlay beg-point end-point 'invisible t
					  'after-string string)
              (idrop-overlays (idrop-active)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Positioning functions

(defun idrop-start-column (width)
  "Returns the column where the idrop list should start"
  (let ((current-column (mod (current-column) (window-width)))
        (window-width (window-width)))
    (cond ( ;; if the idrop fits to the right, starting from current
	   ;; column, return `current-column'
	   (and (not idrop-display-center-p)
		(<= (+ column width) window-width))
	   current-column)
	  ( ;; if the idrop fits in the window at all, center it horizontally   
	   (>= window-width width)
	   (/ (- window-width width) 2))
          (t
	   nil))))

(defun idrop-move-to-start-line (candidate-count &optional total-count)
  "Moves the cursor to the screen line where the first candidate
of the idrop list should be displayed.

Moves upward if no space exists below the current cursor position.

TODO: If no space in either direction, tries to make space below.
TODO: If no space can be made below, recalulates the
idrop-list with a lower number of visible candidates.
"
  (decf candidate-count)
  (let ((above-candidate-count (save-excursion (- (vertical-motion (- candidate-count)))))
        (below-candidate-count (save-excursion (vertical-motion candidate-count))))
    (cond ((= below-candidate-count candidate-count)
           t)
          ((= above-candidate-count candidate-count)
           (vertical-motion (- candidate-count))
           t)
          ((>= (+ below-candidate-count above-candidate-count) candidate-count)
           (vertical-motion (- (- candidate-count below-candidate-count)))
           t)
          (t nil))))


(defun idrop-calculate-width (dd)
  "TODO: document this"
  ;; FIXME: inneficient way to calculate this
  (let* ((filtered (and dd (idrop-filtered dd))))
    (min idrop-current-max-line-width
	 (+ idrop-indicator-width
	    (apply #'max (remove nil
				 (append
				  (list (string-width (idrop-title dd)))
				  (mapcar #'(lambda (c)
					      (idrop-candidate-full-width c))
					  filtered))))))))
    

(defun idrop-calculate-direction (dd)
  ;; TODO: support other directions, `idrop-calculate-direction'
  'down)

(defun idrop-submenu-position (dd)
  ;; TODO: support other positioning, `idrop-submenu-position'
  nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; String construction funtions
(defun idrop-format-line (text width face &optional indicator fill indicator-face)
  "Formats TEXT, applying FACE and optionally adding INDICATOR,
to the width of DD and using FILL as padding.

The length of the string output will be WIDTH +
`idrop-indicator-width'"
  (let* ((real-width (if indicator
			 (- width (string-width indicator))
		       width))
	 ( ;; remove newlines
	  text
	  (replace-regexp-in-string "\n" "\\\\n" text))
	 ;;TODO: remove more special characters here
	 ;; ( ;; insert `idrop-ellipsis-indicator' in the middle
	 ;;  text 
	 ;;  (if (<= (length text) real-width) 
	 ;;      text
	 ;;    (concat
	 ;;     (substring text 0 (/ real-width 2))
	 ;;     idrop-ellipsis-indicator
	 ;;     (substring text (- (/ real-width 2))))))

	 )

    (when (> (string-width text) real-width)
      (setq indicator (concat idrop-ellipsis-indicator indicator))
      (setq real-width (- width (string-width indicator)))
      ;; FIXME: kind of a hack to access `idrop-active' in this
      ;; like this.
      (when (idrop-active) (setf (idrop-truncating-candidates (idrop-active)) t)))   
    (concat (if face
		(propertize (truncate-string-to-width text real-width nil (or fill ? )) 'face face)
	      (truncate-string-to-width text real-width nil (or fill ? )))
	    (and indicator (propertize indicator 'face (or indicator-face
							   'idrop-indicator))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Idrop-construction related functions

(defun idrop-filter-substring (cand)
  (or (not (idrop-text))
      (string-match (idrop-text) cand)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Recalculation and scroll-related functions

(defun idrop-filter (function candidates)
  (cond ((and (idrop-text)
	      (memq 'filter idrop-merge-subcandidates))
	 (idrop-filter-and-merge function candidates))
	((idrop-merging-subcandidates dd)
	 (idrop-filter-and-merge (if (idrop-text) function #'identity) candidates))
	(t
	 (remove-if-not #'(lambda (candidate)
			    (funcall idrop-filter-function (idrop-candidate-string candidate)))
			candidates))))

;; TODO: 5000 points for someone who can write this iteratively, which
;;	 should be faster.
(defun idrop-filter-and-merge (function candidates)
  (mapcan #'(lambda (candidate)
	      (let* ((submenu-p (idrop-candidate-submenu-p candidate))
		     (subs (and submenu-p (idrop-candidate-spawn-subcandidates candidate)))
		     (subsfiltered (and subs (idrop-filter-and-merge function subs))))
		(cond ((and submenu-p (eq idrop-merge-keep-parent-candidate 'always))
		       (cons candidate subsfiltered))
		      ((and submenu-p (eq idrop-merge-keep-parent-candidate 'never))
		       subsfiltered)
		      ((and submenu-p (eq idrop-merge-keep-parent-candidate 'maybe))
		       (when subsfiltered
			 (cons candidate subsfiltered)))
		      ((funcall function (idrop-candidate-string candidate))
		       (cons candidate subsfiltered))
		      (t
		       subsfiltered))))
	  candidates))

(defun idrop-can-scroll (direction dd)
  (cond ((eq direction 'down)
	 (< (+ (idrop-scrolled-out dd) (idrop-nvisible dd))
	    (length (idrop-filtered dd))))
	((eq direction 'up)
	 (/= (idrop-scrolled-out dd) 0))
	(t
	 nil)))

(defun idrop-refilter (dd)
  "Does the \"heavy\" part of recalculating idrop DD"
  (let ((filtered (idrop-filter idrop-filter-function
				(idrop-candidates dd))))

    ;; hide hidden candidates
    (when (idrop-hiding-candidates-p dd)
      (setq filtered (remove-if #'idrop-candidate-hidden-p filtered)))  
    ;;
    (unless (equal filtered (idrop-filtered dd))
      ;; undo any selections and scroll to top
      (setf (idrop-selidx dd)     nil)
      (setf (idrop-scrolled-out dd) 0)
      
      (setf (idrop-filtered dd) filtered)

      (push 'rescroll idrop-recalculate)

      ;; force restretching
      ;; (when (and idrop-vary-width
      ;; 		 (idrop-filtered dd))
      ;; 	(push 'restretch idrop-recalculate))
      )))

(defun idrop-restretch (dd)
  "Recalculates the dimensions (heigth and width) of the idrop DD.

Should be called after `idrop-refilter'"
  (setf (idrop-width dd) (idrop-calculate-width dd))
  (setf (idrop-nvisible dd) (or (and idrop-current-max-height
				     (min (length (idrop-filtered dd))
					  idrop-current-max-height)))))
  

(defun idrop-rescroll (dd)
  "Recalculates the scrolling of the idrop DD.

Should be called after `idrop-restrech'"
  (cond ( ;; don't scroll anywhere
	 (not (idrop-selidx dd))
	 ;; (setf (idrop-scrolled-out dd) 0)
	 )
	( ;; scroll down
	 (>= (idrop-selidx dd) (+ (idrop-nvisible dd)
				  (idrop-scrolled-out dd)))
	 (cond ( ;; scroll down normally, increase `scrolled-out'
		(< (idrop-selidx dd)
		   (idrop-nfiltered dd))
		(incf (idrop-scrolled-out dd)))
	       ( ;; scroll around to beginning of list
		idrop-can-scroll-around
		(setf (idrop-selidx dd) 0)
		(setf (idrop-scrolled-out dd) 0))
	       ( ;; undo the increase in `selidx'
		t
		(decf (idrop-selidx dd)))))
	( ;; scroll up 
	 (< (idrop-selidx dd) (idrop-scrolled-out dd))
	 (cond ( ;; scroll up normally, decrease `scrolled-out'
		(> (idrop-scrolled-out dd) 0)
		(decf (idrop-scrolled-out dd)))
	       ( ;; scroll around to end of list
		idrop-can-scroll-around
		(setf (idrop-selidx dd) (1- (idrop-nfiltered dd)))
		(setf (idrop-scrolled-out dd) (- (length (idrop-filtered dd)) (idrop-nvisible dd))))
	       (t
		;; undo the decrease of `selidx'
		(incf (idrop-selidx dd)))))))

(defun idrop-recalculate-maybe (dd)
  (when (memq 'refilter idrop-recalculate) (idrop-refilter dd))
  (when (memq 'restretch idrop-recalculate) (idrop-restretch dd))
  (when (memq 'rescroll idrop-recalculate) (idrop-rescroll dd))

  (setq idrop-recalculate nil))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Interactive commands for idrop control, 
;;;

(defmacro idrop-command (&rest body)
  (declare (indent 0) (debug t))
  `(setq idrop-last-retcode (progn ,@body)))

(defun idrop-previous-candidate (&optional dd amount)
  "Choose the previous idrop item from DD, with optional
AMOUNT, go up by that amount. May scroll the idrop list."
  (interactive)
  ;; FIXME: horrible HACKS here
  ;; FIXME: if one presses up and no selection, this actually goes
  ;;        down to the first candidate. Should go nowhere or to
  ;;        bottom of list, depending on `idrop-can-scroll-around'
  (let ((dd (or dd
		(idrop-active))))
    (interactive)
    (unless (idrop-selidx dd) (setf (idrop-selidx dd) (1- (idrop-scrolled-out dd))))

    ;; TODO: stop refusing to learn `loop'
    ;; FIXME: direct call to `idrop-rescroll' should be avoided
    (decf (idrop-selidx dd) (or amount 1))
    (idrop-rescroll dd)
    (while (not (idrop-selected dd))
      (decf (idrop-selidx dd) (or amount 1))
      (idrop-rescroll dd))))

(defun idrop-next-candidate (&optional dd amount)
  "Choose the next idrop item from DD, with optional AMOUNT,
go down by that amount. May scroll the idrop list."
  (interactive)
  (idrop-previous-candidate dd (- (or amount 1))))

(defun idrop-magic-backspace (&optional dd amount)
  "Go back in the chain of idrop lists, if applicable"
  (interactive)
  (let ((dd (or dd
		(idrop-active))))
    (cond ( ;; delete the last character
	   (idrop-text)
	   (idrop-execute-edition-command 'backward-delete-char-untabify))
	  ( ;; go back in the chain of idrops
	   (idrop-previous dd)
	   (idrop-undisplay dd)
	   (setq idrop-list (idrop-previous dd))
	   'idrop-continue)
	  (t
	   (idrop-quit)))))

(defun idrop-quit (&optional dd)
  "Quit all the idrop lists"
  (interactive)
  (let ((dd (or dd
		(idrop-active))))
    (idrop-cleanup dd)
    (setq idrop-list nil)
    'idrop-quit))

(defun idrop-confirm (&optional dd)
  "Confirm the current idrop list choice"
  (interactive)
  (let* ((dd (or dd
		 (idrop-active)))
	 (sel (and dd 
		   (idrop-selected dd))))
    (cond (sel
	   (setq idrop-selected-candidate sel)
	   (run-hooks 'idrop-exit-hook)
	   (idrop-candidate-call-callback sel))
	  (t
	   (message "No candidate selected!")
	   (ding)))))

(defun idrop-digit-shortcut (&optional dd)
  (interactive)
  (let* ((dd (or dd
		 (idrop-active)))
	 (n (- last-command-char ?0 1))
	 (selidx (and (>= n 0)
		      (position (nth n (idrop-numbered dd)) (idrop-filtered dd)))))
    (cond (selidx
	   (setf (idrop-selidx dd) selidx)
	   (idrop-confirm dd))
	  (t
	   (list 'idrop-error "Invalid digit selection")))))

(defun idrop-magic-tab (&optional dd)
  (interactive)
  (let ((dd (or dd
		(idrop-active))))
    (cond ( ;; (1) check if anything can be completed, if so
	   ;; complete
	   (idrop-can-complete-user-input-p dd)
	   (idrop-complete-user-input dd))
	  ( ;; (2) check if anything would be gained from enlarging
	   ;; then enlarge horizontally and vertically.
	   (and (or (< (idrop-nvisible dd) (idrop-nfiltered dd))
		    (idrop-truncating-candidates dd))
		(not (idrop-enlarged-p dd)))
	   (idrop-enlarge dd))
	  ( ;; (3) check if merging is possible, if so merge
	   ;; subcandidates
	   (and (memq 'ontab idrop-merge-subcandidates)
		(not (idrop-merging-subcandidates-p dd)))
	   (add-to-list 'idrop-recalculate 'refilter)
	   (add-to-list 'idrop-recalculate 'restretch)
	   (setf (idrop-merging-subcandidates dd) t)
	   'idrop-ontab-merging)
	  ( ;; (4) check if any candidates are hidden, then reveal
	   ;; them
	   (idrop-hiding-candidates-p dd)
	   (idrop-reveal-hidden-candidates dd))
	  ( ;; (5) just scroll up 
	   t
	   (idrop-scroll-up)))))

(defun idrop-do-nothing (&optional dd)
  "Used instead of `undefined' in the local keymaps to prevent
  events like `mouse-1' to be looked up and executed in `global-map'"
  (interactive)
  (idrop-command 'idrop-continue))

(defun idrop-complete-user-input (&optional dd)
  "Complete whatever can be completed in the user's input to the
  idrop"
  (interactive)
  (let ((dd (or dd
		(idrop-active)))
	(message "TODO: add prefix, suffix, whateverix completion")
	(ding))))


(defun idrop-enlarge (&optional dd shrinkinstead)
  "Confirm the current idrop list choice"
  (interactive)
  (let ((dd (or dd
		(idrop-active))))
    (cond ((not shrinkinstead)
	   (setq idrop-current-max-line-width (car idrop-max-dimensions))
	   (setq idrop-current-max-height (cdr idrop-max-dimensions)))
	  (t
	   (setq idrop-current-max-line-width (car idrop-nominal-dimensions))
	   (setq idrop-current-max-height (cdr idrop-nominal-dimensions))))))


(defun idrop-reveal-hidden-candidates (&optional dd)
  (interactive)
  (let ((dd (or dd
		(idrop-active))))
    (setf (idrop-hiding-candidates dd) nil)
    (add-to-list 'idrop-recalculate 'refilter)))

(defun idrop-scroll-up (&optional dd amount scroll-down)
  (interactive)
  (let* ((dd (or dd
		 (idrop-active)))
	 (amount (or amount
		     (- (idrop-nvisible dd)
			(or (and idrop-scroll-context-lines
				 (min idrop-scroll-context-lines
				      (- (idrop-nvisible dd) 1)))
			    0)))))
    (if scroll-down
	(message "TODO: implement scrolling down")
      (if (< (idrop-nvisible dd) (- (idrop-nfiltered dd)
				    (idrop-scrolled-out dd)))
	  (incf (idrop-scrolled-out dd) amount)
	(setf (idrop-scrolled-out dd) 0)))
    (setf (idrop-selidx dd) nil)
    (add-to-list 'idrop-recalculate 'rescroll)))

(defun idrop-scroll-down (&optional dd amount)
  (interactive)
  (idrop-scroll-up dd amount 'scroll-down))

(defun idrop-wheel-scroll-up (&optional dd)
  (interactive)
  (idrop-scroll-up dd 2))

(defun idrop-wheel-scroll-down (&optional dd)
  (interactive)
  (idrop-scroll-down dd 2))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Core functions

(defun idrop-lookup-other-command ()
  (interactive)
  (message "Used %s to invoke %s" (this-command-keys) (lookup-key global-map (this-command-keys) t)))
   
(defun idrop-execute-edition-command (&optional command)  
  "Executes the in-idrop text edition command passed in COMMAND,
or post-processes a recently executed command in the *idrop-text*
buffer."
  ;; execute the command if it was passed
  (when command
    (set-buffer (get-buffer-create "*idrop-text*"))
    (call-interactively command))
  ;; post-process the recent execution of an edition command
  (when (string= (buffer-name (current-buffer)) "*idrop-text*")
    (setq idrop-executing-edition-command nil)
    (if (< (1- (point)) (+ (idrop-width (idrop-active))
			   idrop-indicator-width))
	(progn
	  (setq idrop-text (buffer-substring (point-min) (point-max)))
	  ;; force refiltering and restretching, because possibly
	  ;; merged subcandidates might have to be truncated
	  (add-to-list 'idrop-recalculate 'refilter)
	  (when (memq 'onfiltering idrop-vary-width)
	    (add-to-list 'idrop-recalculate 'restretch)))
      (kill-region (1- (point)) (point-max))
      (ding)))
  (idrop-refresh))

(defvar idrop-exit-hook '(idrop-cleanup))

(defvar idrop-allowed-edition-commands '(self-insert-command backward-delete-char-untabify))

(defun idrop-check-status ()
  (let ((dd (idrop-active)))
    (cond ((memq this-command idrop-allowed-edition-commands)
	   (set-buffer (get-buffer-create "*idrop-text*"))
	   (add-hook 'post-command-hook 'idrop-execute-edition-command nil 'local))
	  ((string-match "idrop-" (symbol-name this-command))
	   ;;(message "continuing the idrop...")
	   (idrop-undisplay dd))
	  (;;
	   ;; quit the idrop
	   ;; 
	   t
	   (message "quitting")
	   (run-hooks 'idrop-exit-hook)))))
  
(defun idrop-refresh ()
  (let ((dd (idrop-active)))
    ;;
    ;; recalculate and redisplay the idrop
    ;;
    (set-buffer (idrop-buffer dd))
    (idrop-recalculate-maybe dd)
    (idrop-display dd)))
  

(defun idrop-internal (candidates &optional title subidrop)
  "Creates the idrop instance from CANDIDATES and waits for
user input before doing anything."
  (idrop-cleanup)
  (let (command
	ret
	(dd (idrop-make-idrop :buffer		     (current-buffer)
			      :candidates	     candidates
			      :hiding-candidates     (some #'idrop-candidate-hidden-p candidates)
			      :merging-subcandidates (memq 'always idrop-merge-subcandidates)
			      :filtered	             candidates
			      :title	             title)))
    
    (idrop-init dd subidrop)

    (when idrop-control-overlay (delete-overlay idrop-control-overlay))
    (setf idrop-control-overlay (make-overlay (point-min) (point-max)))
    ;;(overlay-put idrop-control-overlay  'face     'secondary-selection)
    (overlay-put idrop-control-overlay  'keymap   idrop-control-keymap)
    
    (add-hook 'pre-command-hook  'idrop-check-status 'append)
    (add-hook 'post-command-hook 'idrop-refresh      'append)
    
    (idrop-check-status)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Example usages:
;;;
;;;  x) Replace `completing-read'

(defun idrop-completing-read (title
			      collection
			      &optional predicate require-match
			      initial-input hist def inherit-input-method
			      alt-help
			      alt-sets)
  "Popup a idrop menu to read a string. This function can be
used instead `completing-read'.  

The variables PROMPT, TABLE, PREDICATE, REQUIRE-MATCH,
INITIAL-INPUT, POP-HIST, DEF and INHERIT-INPUT-METHOD all have the
same meaning is for `completing-read'.

ALT-HELP is unused for now. TODO: Use `alt-help' as well.


ALT-SETS should be nil or an association list that has as keys
groups and as second element an alternative that should go into
this group.
"

  ;; `title'	is the title of the idrop
  ;; `collection' must be filtered through all-completions
  ;; `predicate' is passed to all-completions
  ;; `initial-input' is passed as `idrop-text'
  ;; `hist' is a list of past inputs, not past idrops
  ;; `default' should be added to `collection' as the first item
  ;; TODO: `inherit-input-method' is very interesting
  ;; TODO: `alt-help' will be left unused for now, but is very interesting
  ;; `alt-sets', when non-nil should make `collection', turned into a string-returning keymap and passed to `idrop-popup-menu'
  nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;;  x) Using multiple commands for the same key, using a special
;;;  `define-key*' directive.

(defun define-key* (keymap key command)
  "Add COMMAND to the multiple-command binding of KEY in KEYMAP.
Use multiple times to bind different COMMANDs to the same KEY."
  (define-key keymap key (combine-command command (lookup-key keymap key))))

(defun combine-command (command defs)
  "$$$$$ FIXME - no doc string"
  (cond ((null defs) command)
        ((and (listp defs)
              (eq 'lambda (car defs))
              (= (length defs) 4)
              (listp (fourth defs))
              (eq 'command-selector (car (fourth defs))))
         (unless (member `',command (cdr (fourth defs)))
           (setcdr (fourth defs) (nconc (cdr (fourth defs)) `(',command))))
         defs)
        (t
         `(lambda () (interactive) (command-selector ',defs ',command)))))

(defvar command-selector-last-command nil "$$$$$ FIXME - no doc string")

(defun command-selector (&rest candidates)
  "$$$$$ FIXME - no doc string"
  (if (and (eq last-command this-command) command-selector-last-command)
      (call-interactively command-selector-last-command)
    (let* ((candidate-strings
            (mapcar (lambda (candidate)
                      (format "%s" (if (symbolp candidate)
                                       candidate
                                     (let ((s (format "%s" candidate)))
                                       (if (>= (length s) 7)
                                           (concat (substring s 0 7) "...")
                                         s)))))
                    candidates))
           (selection (idrop candidate-strings)))
      (when selection
        (let ((cmd (nth selection candidates)))
          (call-interactively cmd)
          (setq command-selector-last-command cmd))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;;  x) Display a popup-menu, replacement for `x-popup-menu'


(defun idrop-menu-item-separator-p (item)
  nil)

(defun idrop-menu-item-keybinding-cache-p (item)
  (and (consp item)
       (consp (car item))
       (or (null (caar item))
	   (vectorp (caar item)))))

(defun idrop-make-candidate-from-menu-item (item)
  ;; TODO: handle separators
  ;; TODO: handle checkboxes
  ;; TODO: handle exotic properties
  (when (and (consp item)
	     (consp (cdr item)))
    (let* ((item (cdr item)) ;;Ignores first symbol for the menu item
	   name-prop
	   callback-prop
	   help-prop
	   selectable-prop
	   confirmable-prop
	   extra-indicator-prop
	   cachelist)
      (cond ((stringp (first item))
	     (setq name-prop (first item))
	     (setq item (cdr item))
	     ;; Maybe help string
	     (when (and (consp item)
			(stringp (car item)))
	       (setq help-prop (car item))
	       (setq item (cdr item)))
	     
	     ;; Maybe key binding cache
	     (when (idrop-menu-item-keybinding-cache-p item)
	       (setq cachelist (car item))
	       (setq item (cdr item)))
	     ;; This is the real definition--the function to run.
	     (setq callback-prop item)
	     ;; Get enable property, if any.
	     (when (symbolp item)
	       (let ((prop (get item 'menu-enable)))
		 (setq confirmable-prop (or (null prop)
					    prop)))))
	      
	    ((eq (first item) 'menu-item)
	     ;; New format menu item
	     (setq name-prop (second item))
	     (setq callback-prop (third item))
	     (setq item (nthcdr 4 item))
	     ;; Maybe key binding cache
	     (when (idrop-menu-item-keybinding-cache-p item)
	       (setq cachelist (car item))
	       (setq item (cdr item)))
	     (setq confirmable-prop (getf item :enable))
	     (setq help-prop (getf item :help)))
	    (t
	     ;; Not a menu item
	     (return nil)))
      (when cachelist
	(setq extra-indicator-prop (cdr cachelist)))
	
      (idrop-make-candidate :name name-prop 
			    :callback (unless (keymapp callback-prop)
					callback-prop)
			    :selectable selectable-prop
			    :hidden nil
			    :confirmable confirmable-prop
			    :extra-indicator extra-indicator-prop
			    :help help-prop
			    :subcandidates (when (keymapp callback-prop)
					     (list #'idrop-menu-candidates `',callback-prop))))))

(defun idrop-menu-position ()
  nil)

(defun idrop-menu-title (keymap)
  (let ((keymapv (and (keymapp keymap)
		      (if (symbolp keymap)
			  (symbol-value keymap)
			keymap))))
    (when keymapv
      (find-if #'stringp keymapv))))

(defun idrop-menu-candidates (keymap)
  (let ((keymapv (and (keymapp keymap)
		      (if (symbolp keymap)
			  (symbol-value keymap)
			keymap))))
    (remove nil (mapcar #'idrop-make-candidate-from-menu-item
			keymapv))))

(defun idrop-popup-menu (position menu)
  "MENU can be a keymap, or a list of keymaps."  
  (interactive)
  (idrop-internal (idrop-menu-candidates menu)
		  (or
		   (idrop-menu-title menu)
		   "A idrop menu")))
	 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;;  x) Make `hippie-expand' display alternatives in a idrop

(defvar idrop-hippie-expand-max-completions 10
  "Maximum number of `hippie-expand' completions to compute when calling `idrop-hippie-expand'")

(defun idrop-hippie-expand ()
  (interactive)
  (let ((string-to-complete (buffer-substring (line-beginning-position) (point)))
	(completions (list))) 
    (setq he-num -1)
    (setq he-tried-table nil)
    (dotimes (i idrop-hippie-expand-max-completions)
      (let ((last-command 'idrop-hippie-expand))
	(call-interactively 'hippie-expand))
      (if (not (eq (+ he-string-beg
		      (length he-search-string))
		   (point)))
	  (setq completions (append completions (list (buffer-substring (+ he-string-beg
									   (length he-search-string)) (point)))))
	(return)))
    (he-reset-string)
    (if completions
	;; TODO: turn this into `idrop-completing-read' when its ready
	(let ((ret (idrop-internal (mapcar #'(lambda (string)
					       (make-idrop-candidate :name string))
					   completions)
				   "hippie-expand:")))
	  ;; (message "idrop-hippie-expand: ret was %s" ret)
	  (when ret (insert ret)))
      (message "No idrop-hippie-expand completions"))))

(provide 'dropdown)
(provide 'idrop)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; idrop.el ends here

